home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / HardwareProjects / VideoText.lha / VideoText4.2 / source / decode.p < prev    next >
Encoding:
Text File  |  1995-05-31  |  8.6 KB  |  218 lines
  1. UNIT decode; {$project vt}
  2. { Zeichensatzkonvertierung zum Programm VideoText }
  3.  
  4. INTERFACE; FROM vt USES global;
  5.  
  6. PROCEDURE makeascii(source: p_onepage; zeile: Integer; farblos: Boolean;
  7.                     var asciicode: str80);
  8. PROCEDURE decode_line(source: p_onepage; zeile: Integer; verdeckt: Boolean;
  9.           VAR amigacode: bigstring; VAR attrib: str80;
  10.           VAR dblheight,rastergfx: Boolean);
  11. PROCEDURE gettopnum(source: p_onepage; x,y: Integer; VAR pg,sp: Integer);
  12. VAR blank40: String[41];
  13.     topcode: ARRAY[0..255] OF Byte;
  14.     colperms: ARRAY[0..8] OF Char;
  15.  
  16. { ---------------------------------------------------------------------- }
  17.  
  18. IMPLEMENTATION;
  19.  
  20. {$opt q,s+,i+ } { keine Laufzeitprüfungen außer Stack und Feldindizes }
  21.  
  22. VAR notascii: ARRAY[32..127] OF Byte; STATIC;
  23.     vt_to_ascii, vt_to_myfont: ARRAY[0..7] OF String[15]; STATIC;
  24.     j: Integer;
  25.  
  26. PROCEDURE makeascii{(source: p_onepage; zeile: Integer; farblos: Boolean;
  27.                     VAR asciicode: str80)};
  28. { Eine Zeile einer VT-Seite für Drucker- oder Dateiausgabe umwandeln. }
  29. { Für <farblos>=false werden Farbcodes nicht einfach weggeworfen, sondern }
  30. { durch Klartext '\0' .. '\7'  umschrieben. }
  31. VAR thisbyte,group8,group32,country: Byte;
  32.     start, spalte, i: Integer;
  33.     grafik: Boolean;
  34. BEGIN
  35.   IF source=Nil THEN
  36.     asciicode := blank40
  37.   ELSE BEGIN
  38.     country := (source^.cbits SHR 12) AND $07;
  39.     start := zeile*40;
  40.     grafik := false;
  41.     i := 1;
  42.     FOR spalte := 0 TO 39 DO BEGIN
  43.       thisbyte := source^.chars[start+spalte];
  44.       group8 := thisbyte SHR 3;   { 8er-Gruppe }
  45.       group32 := group8 SHR 2;   { 32er-Gruppe }
  46.       IF group8=0 THEN  grafik := False;
  47.       IF group8=2 THEN  grafik := True;
  48.       IF (group32=2) OR (NOT grafik AND (group32 in [1..3])) THEN
  49.         { druckbares Zeichen, über Tabellen decodieren }
  50.         IF notascii[thisbyte]>0 THEN
  51.           asciicode[i] := vt_to_ascii[country][notascii[thisbyte]]
  52.         ELSE
  53.           asciicode[i] := Chr(thisbyte)
  54.       ELSE
  55.         asciicode[i] := ' ';
  56.       IF NOT farblos AND (group8=0) THEN BEGIN    { Farbcode als Klartext }
  57.         asciicode[i] := '\'; Inc(i); asciicode[i] := chr(thisbyte+ord('0'));
  58.       END;
  59.       Inc(i);
  60.     END;
  61.     asciicode[i] := Chr(0);
  62.   END;
  63. END;
  64.  
  65. {$opt i-}
  66. PROCEDURE decode_line{(source: p_onepage; zeile: Integer; verdeckt: Boolean;
  67.           VAR amigacode: bigstring; VAR attrib: str80;
  68.           VAR dblheight,rastergfx: Boolean)};
  69. { Setzt eine Zeile Teletextzeichen (40 Zeichen) in einen String für den }
  70. { Amiga um (bis zu 160 Zeichen, leider), mit ANSI-Steuerzeichen, für meinen }
  71. { videotext.font. <attrib> dient zur Hilfe bei der Darstellung gerasterter }
  72. { Grafikzeichen. }
  73. { Stringfunktionen absichtlich vermieden, soll vor allem schnell sein! }
  74. VAR vfarbe, hfarbe, country, thisbyte, lastout, group32: Byte;
  75.     grafik, raster, hold, geheim: Boolean;
  76.     start,spalte,i: Integer;
  77. BEGIN
  78.   country := (source^.cbits SHR 12) AND $07;
  79.   vfarbe := 7; hfarbe := 0; lastout := 32;
  80.   grafik := False; raster := False; hold := False; geheim := False;
  81.   dblheight := False; rastergfx := False;
  82.   i := 1;
  83.   start := zeile*40;
  84.   FOR spalte := 0 TO 39 DO BEGIN
  85.     thisbyte := source^.chars[start+spalte] AND $7F;
  86.     IF thisbyte<32 THEN BEGIN  { Steuerzeichen }
  87.       geheim := False;  { jedes Steuerzeichen außer 24 schaltet geheim aus! }
  88.       IF thisbyte=30 THEN hold := True;
  89.       IF thisbyte=31 THEN hold := False;
  90.       IF hold THEN BEGIN { Grafikzeichen wiederholen, Steuerzeichen ausführen }
  91.         amigacode[i] := Chr(lastout); Inc(i);
  92.         IF raster AND (lastout SHR 5 IN [5,7]) THEN  { Grafikzeichen? }
  93.           attrib[spalte+1] := Chr(Ord(colperms[hfarbe])-32)
  94.         ELSE
  95.           attrib[spalte+1] := Chr(Ord(colperms[hfarbe])-48);
  96.       END; { ELSE: s. u. }
  97.       CASE thisbyte OF
  98.         0..7: BEGIN { neue Textfarbe }
  99.           grafik := False;
  100.           vfarbe := thisbyte;
  101.           amigacode[i] := #155; Inc(i);
  102.           amigacode[i] := '3';  Inc(i);
  103.           amigacode[i] := colperms[vfarbe]; Inc(i);
  104.           amigacode[i] := 'm';  Inc(i);
  105.         END;
  106.         13: dblheight := True; { doppelthohe Zeichen }
  107.         16..23: BEGIN { neue Grafikfarbe }
  108.           grafik := True;
  109.           vfarbe := thisbyte-16;
  110.           amigacode[i] := #155; Inc(i);
  111.           amigacode[i] := '3';  Inc(i);
  112.           amigacode[i] := colperms[vfarbe]; Inc(i);
  113.           amigacode[i] := 'm';  Inc(i);
  114.         END;
  115.         24: geheim := True;
  116.         25: raster := False; { gerasterte Grafikzeichen }
  117.         26: BEGIN raster := True; rastergfx := True; END;
  118.         28: BEGIN { Hintergrund schwarz }
  119.           hfarbe := 0;
  120.           amigacode[i] := #155; Inc(i);
  121.           amigacode[i] := '4';  Inc(i);
  122.           amigacode[i] := colperms[0];  Inc(i);
  123.           amigacode[i] := 'm';  Inc(i);
  124.         END;
  125.         29: BEGIN { Zeichenfarbe als Hintergrund }
  126.           hfarbe := vfarbe;
  127.           amigacode[i] := #155; Inc(i);
  128.           amigacode[i] := '4';  Inc(i);
  129.           amigacode[i] := colperms[hfarbe]; Inc(i);
  130.           amigacode[i] := 'm';  Inc(i);
  131.         END;
  132.         OTHERWISE;
  133.       END;
  134.       IF NOT hold THEN BEGIN { Steuerzeichen ausgeführt, Leerzeichen ausgeben }
  135.         amigacode[i] := ' '; Inc(i);
  136.         IF raster AND grafik THEN attrib[spalte+1] := Chr(Ord(colperms[hfarbe])-32)
  137.         ELSE attrib[spalte+1] := Chr(Ord(colperms[hfarbe])-48);
  138.       END; { ELSE: s. o. }
  139.     END ELSE BEGIN { druckbares Zeichen }
  140.       { Rasterattribut? }
  141.       IF raster AND grafik AND NOT (thisbyte IN [64..95]) THEN  { Grafikzeichen? }
  142.         attrib[spalte+1] := Chr(Ord(colperms[hfarbe])-32)
  143.       ELSE
  144.         attrib[spalte+1] := Chr(Ord(colperms[hfarbe])-48);
  145.       { Grafikzeichen? }
  146.       IF grafik AND NOT (thisbyte IN [64..95]) THEN
  147.         thisbyte := thisbyte + 128
  148.       ELSE IF notascii[thisbyte]>0 THEN
  149.         thisbyte := Ord(vt_to_myfont[country][notascii[thisbyte]]);
  150.       { verdecktes Zeichen? }
  151.       IF (geheim AND verdeckt) THEN
  152.         amigacode[i] := ' '
  153.       ELSE
  154.         amigacode[i] := Chr(thisbyte); Inc(i);
  155.       { nur echte Grafikzeichen für "hold"-Wiederholung merken: }
  156.       IF thisbyte SHR 5 IN [5,7] THEN
  157.         lastout := thisbyte ELSE lastout := 32;
  158.     END;
  159.   END;
  160.   amigacode[i] := Chr(0);
  161. END;
  162. {$opt i+}
  163.  
  164. PROCEDURE gettopnum{(source: p_onepage; x,y: Integer; VAR pg,sp: Integer)};
  165. { Eine Seitennummer pg/sp aus einer TopText-Seite auslesen }
  166. { Rückgabewert -1 bedeutet, daß unerlaubte Ziffern aufgetreten sind }
  167. VAR i,j,z: Integer;
  168.     illegal: Boolean;
  169. BEGIN
  170.   i := x + 40*y;
  171.   pg := 0; illegal := False;
  172.   FOR j := 0 TO 2 DO BEGIN
  173.     z := topcode[source^.chars[i+j]];
  174.     pg := (pg SHL 4)+z;
  175.     IF z>15 THEN illegal := True;
  176.   END;
  177.   IF illegal THEN pg := -1;
  178.   sp := 0; illegal := False;
  179.   FOR j := 3 TO 6 DO BEGIN
  180.     z := topcode[source^.chars[i+j]];
  181.     sp := (sp SHL 4)+z;
  182.     IF z>15 THEN illegal := True;
  183.   END;
  184.   IF illegal THEN sp := -1;
  185. END;
  186.  
  187. BEGIN   { Initialisierungsteil }
  188.   { VT-Zeichensatzdekodierung }
  189.   { Welche (druckbaren) Zeichen müssen überhaupt dekodiert werden? }
  190.   FOR j := 32 TO 127 DO notascii[j] := 0;
  191.   FOR j := 0 TO 1 DO notascii[35+j] := 1+j;
  192.   notascii[64] := 3;
  193.   FOR j := 0 TO 5 DO notascii[91+j] := 4+j;
  194.   FOR j := 0 TO 3 DO notascii[123+j] := 10+j;
  195.   { Durch welche Zeichen werden sie ersetzt, a) im Standard-Amiga-Zeichensatz, }
  196.   { b) in meinem videotext.font? }
  197.   { Die Ländernummern (aus den Steuerbits als C12 + 2*C13 + 4*C14 berechnet) }
  198.   { sind: 0=England, 1=Frankreich, 2=Schweden, 3=reserviert, 4=Deutschland, }
  199.   { 5=Spanien, 6=Italien, 7=reserviert. }
  200.   vt_to_ascii[0] := '£$@«½»^#­¼|¾÷'; vt_to_myfont[0] := 'Á$ÀÂÈÄÃ#-ÇÅÉÆ'; { GB }
  201.   vt_to_ascii[1] := 'éïàëêùî#èâôûç'; vt_to_myfont[1] := 'Ô×ÎÔÕÝØ#ÓÐÜßÒ'; { F }
  202.   vt_to_ascii[2] := '#¤ÉÄÖÅÜ_éäöåü'; vt_to_myfont[2] := '#ÌE[\Í]_Ô{|Ñ}'; { S }
  203.   vt_to_ascii[3] := '£$@«½»^#­¼|¾÷'; vt_to_myfont[3] := 'Á$ÀÂÈÄÃ#-ÇÅÉÆ'; { ?? }
  204.   vt_to_ascii[4] := '#$§ÄÖÜ^_°äöüß'; vt_to_myfont[4] := '#$@[\]^_`{|}~'; { D }
  205.   vt_to_ascii[5] := 'ç$¡áéíóú¿üñèà'; vt_to_myfont[5] := 'Ò$ÊÏÔ×ÛÞË}ÙÓÎ'; { E }
  206.   vt_to_ascii[6] := '£$é°ç»^#ùàòèì'; vt_to_myfont[6] := 'Á$Ô`ÒÄÃ#ÝÎÚÓÖ'; { I }
  207.   vt_to_ascii[7] := '£$@«½»^#­¼|¾÷'; vt_to_myfont[7] := 'Á$ÀÂÈÄÃ#-ÇÅÉÆ'; { ?? }
  208.   { Decodierung der TopText-Ziffern 0..F }
  209.   FOR j := 0 TO 255 DO topcode[j] := 16; { unmögliche Ziffer=Fehler }
  210.   topcode[21]  := 0; topcode[2]   := 1; topcode[73] := 2;  topcode[94] := 3;
  211.   topcode[100] := 4; topcode[115] := 5; topcode[56] := 6;  topcode[47] := 7;
  212.   topcode[80]  := 8; topcode[71]  := 9; topcode[12] := 10; topcode[27] := 11;
  213.   topcode[33] := 12; topcode[54] := 13; topcode[125] := 14; topcode[106] := 15;
  214.   FOR j := 1 TO 40 DO blank40[j] := ' ';
  215.   blank40[41] := #0;
  216.   colperms := '01234567';   { Zuordnung VT-Farben/Screen-Farben }
  217. END.
  218.